home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / art&graf.ix / art-0039 / source / dcprnt24.mod < prev    next >
Text File  |  1997-04-16  |  9KB  |  318 lines
  1. IMPLEMENTATION MODULE DCPrnt24;
  2.  
  3. (* This program will PRINT pictures.                                 *)
  4.  
  5. (*--------------------------------------------------------------------*)
  6. (*          Version  2.00        August 1988      L.G. Miller.        *)
  7. (*          Version  1.00         April 1987      L.G.M.              *)
  8. (*--------------------------------------------------------------------*)
  9.  
  10. (* Pressing any mouse button whilst printing will request an
  11.    ABORT of the print.
  12.  *)
  13.  
  14.  
  15. (*    IMPORT Trace;  *)
  16.  
  17. FROM SYSTEM             IMPORT ADDRESS, ADR;
  18.  
  19. FROM Bios               IMPORT bcostat, bconout;
  20.  
  21.  
  22. FROM    DCPrtCnv        IMPORT PrtCnv24BitSlice;
  23.  
  24. IMPORT Forms;
  25.  
  26. FROM VDI                IMPORT vq_mouse;
  27.  
  28. FROM ManyWindows        IMPORT VDIHandle, ShowAlert;
  29.  
  30. FROM Strings            IMPORT String, Concat;
  31.  
  32. FROM DCGlobal           IMPORT
  33. (* CONST *)
  34.  
  35.   HiResMaxX,         (* =  639; *)  
  36.   HiResMaxY,         (* =  399; *)  
  37.   HiResNoPlanes,     (* =  1; *)
  38.  
  39.  
  40. (* TYPE *)
  41.  
  42.   PrinterTypes,
  43.  
  44.   HiResScreen,
  45.  
  46.   PictureImage,
  47.   PrintImage;
  48.  
  49. (*  ---------------------------------------------------------- *)
  50. CONST
  51.    ESC = CHR(1BH);
  52.    BITSPERBYTE     =  8;
  53.    BITSPERWORD  = 16;
  54.    PRT          =  0;
  55.    CON          =  2;
  56.  
  57.  
  58. TYPE 
  59.    PrintLine = ARRAY [ 0 .. 10000 ] OF CHAR; (* a BIG buffer *)
  60.  
  61.  
  62. VAR
  63.     PrintLineBuffer : PrintLine;
  64.  
  65.  
  66.  
  67. PROCEDURE WaitForNoMouse;
  68.   VAR dummy : CARDINAL;
  69.       stat  : BITSET;
  70.   BEGIN
  71.     REPEAT vq_mouse(VDIHandle, stat,dummy,dummy) UNTIL stat = {};
  72.   END WaitForNoMouse;
  73.  
  74.  
  75. PROCEDURE CheckPrinterReady() : BOOLEAN;
  76.   VAR i : LONGCARD;
  77.   BEGIN
  78.     i := 100000;
  79.     WHILE ( bcostat(PRT) = 0 ) &  ( i > 0 ) DO DEC(i) END;
  80.     RETURN ( i > 0 );
  81.   END CheckPrinterReady;  
  82.  
  83.  
  84. PROCEDURE GetPrinterReadyMsg () : BOOLEAN; (* ABORT if FALSE *)
  85.   VAR f : BOOLEAN;
  86.       i : CARDINAL;
  87.   BEGIN
  88.     REPEAT
  89.      i := ShowAlert('Printer Not Ready!!!|CANCEL will ABORT print',2,1);
  90.      IF i = 2  THEN WaitForNoMouse; RETURN FALSE END;
  91.     UNTIL CheckPrinterReady();
  92.     WaitForNoMouse;
  93.     RETURN TRUE
  94.   END GetPrinterReadyMsg;
  95.  
  96.  
  97. PROCEDURE QueryAbort() : BOOLEAN; (* If left button down then prompt *)
  98.   CONST leftbutton = 15; (* bit numbering starts on left *)
  99.         rightbutton= 14;
  100.   VAR i, dummy : CARDINAL;
  101.       bstatus  : BITSET;
  102.   BEGIN
  103.     vq_mouse(VDIHandle, bstatus, dummy, dummy);
  104.     IF ( leftbutton  IN bstatus )
  105.     OR ( rightbutton IN bstatus ) THEN
  106.       i:= ShowAlert('CONTINUE THE PRINT?|CANCEL will ABORT the print',2,1);
  107.       WaitForNoMouse;
  108.     END;  
  109.     RETURN ( i = 2 ); 
  110.   END QueryAbort;
  111.  
  112.  
  113. PROCEDURE  PrintChar ( ch : CHAR ) : BOOLEAN; (* ABORT if FALSE *)
  114.   BEGIN
  115.     LOOP
  116.       IF CheckPrinterReady() THEN
  117.          bconout(PRT,ch);
  118.          RETURN TRUE
  119.       ELSE
  120.          IF NOT GetPrinterReadyMsg() THEN RETURN FALSE END;
  121.       END;
  122.     END; 
  123.   END PrintChar;
  124.  
  125.  
  126. PROCEDURE PrintString ( VAR s : ARRAY OF CHAR; n : CARDINAL ) : BOOLEAN;
  127.   VAR i : CARDINAL;
  128.       printed : BOOLEAN;
  129.   BEGIN
  130.     i := 0;
  131.     REPEAT
  132.       printed := PrintChar(s[i]);
  133.       INC(i);
  134.     UNTIL ( i >= n ) OR NOT printed;
  135.     RETURN printed;
  136.   END PrintString;
  137.  
  138.  
  139. PROCEDURE SetPrinterMode( linewidth, modeno : INTEGER ) : BOOLEAN;
  140.   VAR printed : BOOLEAN;
  141.       s : String;
  142.   BEGIN
  143.     s[0] := ESC;
  144.     s[1] := '*';
  145.     s[2] := CHAR(modeno);
  146.     s[3] := CHAR(linewidth MOD 256 );  
  147.     s[4] := CHAR(linewidth DIV 256 );
  148.     RETURN PrintString(s,5)   
  149.   END SetPrinterMode;
  150.  
  151.  
  152. PROCEDURE SetHiPrinterMode( linewidth, modeno : INTEGER ) : BOOLEAN;
  153.   VAR printed : BOOLEAN;
  154.       s : String;
  155.   BEGIN
  156.     s[0] := ESC;
  157.     s[1] := '*';
  158.     s[2] := CHAR(modeno);
  159.     s[3] := CHAR(linewidth MOD 256 );  
  160.     s[4] := CHAR(linewidth DIV 256 );
  161.     RETURN PrintString(s,5)   
  162.   END SetHiPrinterMode;
  163.  
  164.  
  165. PROCEDURE SetLineFeedDepth( n180ths : INTEGER ) : BOOLEAN;
  166.   VAR s : String;
  167.   BEGIN
  168.     s[0] := ESC; s[1] := '3'; s[2] := CHAR(n180ths);
  169.     RETURN PrintString(s,3);
  170.   END SetLineFeedDepth;
  171.  
  172.  
  173. PROCEDURE PrintCRLF (n : INTEGER) :  BOOLEAN;
  174.   VAR s : String;
  175.       printed : BOOLEAN;
  176.       i : INTEGER;
  177.   BEGIN
  178.     s[0] := CHAR(13);
  179.     s[1] := CHAR(10);
  180.     i := 1;
  181.     WHILE PrintString(s,2) & ( i < n ) DO INC(i) END;
  182.     RETURN ( i >= n );
  183.   END PrintCRLF;
  184.  
  185.  
  186. PROCEDURE PrintBottomMargin ( n : CARDINAL ) : BOOLEAN;
  187.     VAR i : CARDINAL;
  188.   BEGIN
  189.     i := 0;
  190.     WHILE PrintChar(' ') & ( i < n ) DO INC(i) END;
  191.     RETURN ( i >= n );
  192.   END PrintBottomMargin;
  193.  
  194.  
  195. PROCEDURE SetFormLength ( n : CARDINAL ) : BOOLEAN;
  196.   VAR s : String;
  197.   BEGIN
  198.     s[0] := ESC; s[1] := 'C'; s[2] := 0C; s[3] := CHAR(n);
  199.     RETURN PrintString(s,4);
  200.   END SetFormLength;
  201.  
  202.  
  203. PROCEDURE ResetPrinter() : BOOLEAN;
  204.   VAR s : String;
  205.   BEGIN
  206.     s[0] := ESC; s[1] := '@'; 
  207.     RETURN PrintString(s,2);
  208.   END ResetPrinter;
  209.  
  210.  
  211. PROCEDURE FormFeed() : BOOLEAN;
  212.   VAR s : String;
  213.   BEGIN
  214.     s[0] := CHAR(12);  
  215.     RETURN PrintString(s,1);
  216.   END FormFeed;
  217.  
  218.  
  219. (*----------------------------------------------------------------------*)
  220. (* Print landscape picture                                              *)
  221. (*----------------------------------------------------------------------*)
  222. PROCEDURE PrintHiResPicture24L ( VAR PictureDetails : PictureImage;
  223.                                  VAR PrintDetails   : PrintImage;
  224.                                  VAR Picture : HiResScreen );
  225.         
  226.   VAR      nomore, newpic : BOOLEAN;
  227.         
  228.   BEGIN
  229.     nomore := FALSE;
  230.     newpic := TRUE;
  231.  
  232.     IF NOT ResetPrinter() THEN RETURN END;
  233.     IF NOT SetFormLength(11) THEN RETURN END;
  234.     IF NOT PrintCRLF(PrintDetails.StartCharY) THEN RETURN END;
  235.     IF NOT SetLineFeedDepth(24) THEN RETURN END;
  236.  
  237.     REPEAT
  238.       PrtCnv24BitSlice( newpic,    (* first time thru = TRUE *)
  239.                         nomore,    (* all slices retrieved   *)
  240.                         Picture,   (* screen to print        *)
  241.  
  242.                         PictureDetails.StartX,
  243.                         PictureDetails.StartY,
  244.                         PictureDetails.Width,
  245.                         PictureDetails.Height,
  246.  
  247.                         PrintDetails.Width,
  248.                         PrintDetails.Height,
  249.                         PrintDetails.QueryLandscapePrint,
  250.  
  251.                         PrintLineBuffer );
  252.  
  253.       newpic := FALSE;
  254.       IF NOT PrintBottomMargin(PrintDetails.StartCharX) THEN RETURN END;
  255.       IF NOT SetPrinterMode(PrintDetails.Height, 39) THEN RETURN END;
  256.       IF NOT PrintString(PrintLineBuffer, PrintDetails.Height * 3) THEN
  257.          RETURN
  258.        END;
  259.       IF NOT SetLineFeedDepth(24) THEN RETURN END;
  260.       IF NOT PrintCRLF(1) THEN RETURN END;
  261.       IF QueryAbort() THEN RETURN END;
  262.     UNTIL nomore;
  263.     
  264.     IF NOT ResetPrinter() THEN RETURN END;
  265.   END PrintHiResPicture24L;
  266.  
  267.  
  268. (*----------------------------------------------------------------------*)
  269. (* Print portrait picture                                               *)
  270. (*----------------------------------------------------------------------*)
  271. PROCEDURE PrintHiResPicture24P ( VAR PictureDetails : PictureImage;
  272.                                  VAR PrintDetails   : PrintImage;
  273.                                  VAR Picture : HiResScreen );
  274.         
  275.   VAR      nomore, newpic : BOOLEAN;
  276.         
  277.   BEGIN
  278.     nomore := FALSE;
  279.     newpic := TRUE;
  280.  
  281.     IF NOT ResetPrinter() THEN RETURN END;
  282.     IF NOT SetFormLength(11) THEN RETURN END;
  283.     IF NOT PrintCRLF(PrintDetails.StartCharY) THEN RETURN END;
  284.     IF NOT SetLineFeedDepth(24) THEN RETURN END;
  285.  
  286.     REPEAT
  287.       PrtCnv24BitSlice( newpic,    (* first time thru = TRUE *)
  288.                         nomore,    (* all slices retrieved   *)
  289.                         Picture,   (* screen to print        *)
  290.  
  291.                         PictureDetails.StartX,
  292.                         PictureDetails.StartY,
  293.                         PictureDetails.Width,
  294.                         PictureDetails.Height,
  295.  
  296.                         PrintDetails.Width,
  297.                         PrintDetails.Height,
  298.                         PrintDetails.QueryLandscapePrint,
  299.  
  300.                         PrintLineBuffer );
  301.  
  302.       newpic := FALSE;
  303.       IF NOT PrintBottomMargin(PrintDetails.StartCharX) THEN RETURN END;
  304.       IF NOT SetPrinterMode(PrintDetails.Width, 39) THEN RETURN END;
  305.       IF NOT PrintString(PrintLineBuffer, PrintDetails.Width * 3) THEN
  306.          RETURN
  307.        END;
  308.       IF NOT SetLineFeedDepth(24) THEN RETURN END;
  309.       IF NOT PrintCRLF(1) THEN RETURN END;
  310.       IF QueryAbort() THEN RETURN END;
  311.     UNTIL nomore;
  312.     
  313.     IF NOT ResetPrinter() THEN RETURN END;
  314.  
  315.   END PrintHiResPicture24P;
  316.  
  317. END DCPrnt24.
  318.